home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / timing.swg / 0011_Free time for DV.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-08-27  |  824 b   |  48 lines
  1. {
  2. > Does anyone know how to give up your free time under dv or dv/x? Or make
  3. > these programs desqview aware?
  4.  
  5. DONATED TO THE PUBLIC DOMAIN by Danny Melton
  6. }
  7.  
  8. program YourProgramHere;
  9.  
  10. uses
  11.   DOS, CRT;
  12.  
  13. const
  14.   MultiTasking : boolean = false;
  15.  
  16. function UnderDV : boolean;
  17. var
  18.   R : registers;
  19. begin
  20.   if MultiTasking then
  21.     exit;
  22.   R.AX := $1022;
  23.   R.BX := $0000;
  24.   intr($15, R);
  25.   MultiTasking := boolean(R.BX <> 0);
  26.   UnderDV := MultiTasking;
  27. end;
  28.  
  29. procedure GiveUpTimeSlice;
  30. var
  31.   R : registers;
  32. begin
  33.   if not MultiTasking then
  34.     exit;
  35.   R.AX := $1000;
  36.   intr($15, R);
  37. end;
  38.  
  39. begin
  40.   if UnderDV then
  41.     writeln('Running under a multi-tasker.');
  42.   writeln('Press a key when ready');
  43.   while not keypressed do
  44.     GiveUpTimeSlice;
  45.   writeln('You pressed a key.');
  46. end.
  47.  
  48.